perm filename SCMSS.OL2[NEW,LCS] blob sn#445305 filedate 1979-05-29 generic text, type T, neo UTF8
00100	C******  SCMSS *********** 12/1/75
00200		SUBROUTINE SCMSS
00300		COMMON /PLTR/PLT,RHT,DIS/PTR/KWDS(1) 
00400		1 /MKX/KSLA,ISM,LESS,IGT,NNO(5),MINUS
00500		COMMON/RINP/R(10,85),RPOS(2,50) /RMOD/RMODE2,SET4,IBEAM,NOSET,
00600		1 STEM,STUP,NTC,PS2,RAM,RDD,ITB,POSB /JCHAR/IXX,ISEMI,IBLA
00700		1 /A2Z/LAA,LBB,A1(4),LGG,A2(6),LNN,LOH,A3(3),LSS,LTT,A4(4),LYY
00800		1 /NUM/NUM(9),N9
00900	       COMMON R2,JA,G,H,R3,U(39)/SCM/V(78),I,LCNT,STAFF,JLIST(200),REND
01000	C JLIST WILL SOMETIMES BE USED(WIPED OUT) FOR R(X,Y) OVERFLOW(>50 ITEMS.)
01100		DIMENSION RLIST(200),NOMOR(6),WARN(6),ISV(5)
01200	C  /SCX/ ALSO IN WORDS, NEWR
01300		COMMON/SCX/JALPHA(30),RB,RC,JZ,IRHY,JD,KA,KB,IZ
01400		1/STF/RSTFAC(8),RSTJ2 /LIMIT/LIMIT,ITEM,LL,IS,IX
01500		1 /FRMT/F78F(1),FA1(1),FA5(1),IREAD /IDEV/IDEV
01600		1/XRN/RN(1) /ALF/INP(72),ML /POS/POS1,POS2,PSFB
01700		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JN,DBST
01800		1,NFLG,JXX,ISEMX,JG,VX(50),IAMP,K,KN,M,MODE,IBLX
01900	      EQUIVALENCE (VX1,VX(1)),(INP1,INP(1)),(VX2,VX(2)),(VX3,VX(3)),
02000	     1(VX4,VX(4)),(VX5,VX(5)),(JLIST,RLIST)
02100		1 ,(INP2,INP(2)),(INP3,INP(3)),(INP4,INP(4))
02200		1,(ISTAR,JALPHA(8)),(ICOL,JALPHA(9)),(IRP,JALPHA(6)),
02300		1(ILP,JALPHA(5)),(NEG,JALPHA(2)),(IAT,JALPHA(16)),(IDOT,
02400		1JALPHA(3))
02500	C--THESE ARE IN 'RESTS' NOW.	DATA IXX/'X'/,LCNT/1/,ISEMI/';'/,IBLA/' '/
02600		JDEV=IDEV
02700	1177	RB=0
02800	CC	IF(JA.EQ.140)GO TO 77
02900	CC	IF(JA.NE.144)GO TO 11
02950		IF(JA.NE.140)GO TO 11
03000	77	MODE=1
03050		IF(IDEV.EQ.5)WRITE(21,2114)INP
03075	C WRITE OUT 'IN' ETC.
03100		IBEAM=-1
03200		IZ=0
03300	CC	IREAD=0
03400		POS2=0
03500		POS1=0
03600	CC	THIS IS SET IN MSX NOW ****  RMODE2=R3
07700	91	CALL TYPSTR('SPACING STAFF =')
07800		CALL TYPFLT(SET4)
07900		CALL TYPCRLF
08000		GO TO 111 
08100	
08200	491	RB=0
08326		CALL TYPSTR('STAFF NUM=')
08389		ACCEPT 80052,STAFF
08578		CALL A2READ(RA,RB)
08641		IF(RA.NE.'SP')GO TO 91
08704	C NOW SPACER CAN BE SET AT THIS POINT
08767		SET4=RB
08830		GO TO 111
08900	11	RB=0
09000		GO TO 111
09100	467	IDEV=5
09200		GO TO 4333
09300	444	SET4=RA
09400	111	CALL SETUP
09500		IF(STUP.GE.0)GO TO 8
09600	C SKIPS IF USING SETUP ON SOME STAFF
09700		IF(POS2.NE.0)GO TO 4334
09800	C JUMP IF POS1, POS2, ETC. WERE SET UP IN FILE (* SP  ST  POS1  POS2  X)
09900	4333  	IF(IDEV.EQ.5)CALL TYPSTR('TYPE POS1, POS2, (SPC)  ')
10000		READ(IDEV,F78F,END=467)POS1,POS2,PSFB
10100	C  DON'T USE INVIS. RESTS WITH SPACING FEATURE!!!!
10200		IF(IDEV.NE.5)GO TO 5333
10300		REREAD 2114,INP
10350		WRITE(21,2114)INP
10375	C WRITE OUT SPACING INFO
10400	5333	CALL A2READ(K,RA)
10500		IF(K.EQ.'SP')GO TO 444
10600	C TYPE "SPn" TO SET SPACING STAFF AT THIS POINT.
10700		IF(K.EQ.IAT)GO TO 467
10800	CATCH '@' WHEN POS1 AND P2 ARE EXPECTED.
10900		IF(K.EQ.LESS)GO TO 467
11000		IF(K.NE.IGT)GO TO 567
11100		IDEV=1
11200		GO TO 4333
11300	567	IF(POS2.EQ.0)POS2=200.
11400		IF(POS1.GE.POS2)GO TO 4333
11500	C  TYPE ANY POSITIVE 3RD NUM. FOR PSUEDO-FIBONACCI SPACING OF RHYTH.
11600	4334	STUP=STUP-PSFB
11800	
12100	8	CALL TYPCRLF
12200		IF(RB.GT.0)GO TO 891
12400	367	GO TO (1,2,3,4,5,677)MODE
12600		GO TO 2177
12900	C************ IS NEXT NEEDED (SEE AT 667) ???∂*************
13000	2303	RB=0
13400		POS2=0
13600		GO TO 491
13700	
14800	167	IDEV=5
14900	891	CALL TYPSTR('STAFF NUM=')
15000	CC	IF(RB)GO TO 231
15100		IF(STFNUM(STAFF))GO TO 2305
15200	231	CALL TYPFLT(STAFF)
15300	CC	IF(RB.GE.0)GO TO 2177
15350		GO TO 2177
15400		CALL TYPCRLF
15600		GO TO 91
16500	2305	READ(IDEV,80052,END=167)STAFF
16600	  	IF(STAFF.NE.444)GO TO 2177
16900		CALL A2READ(RA,RB)
17000		IF(RA.EQ.LESS)GO TO 167
17100		IF(RA.NE.IGT)GO TO 667
17200		IDEV=1
17300		GO TO 891
17400	667	IF(RA.NE.'SP')GO TO 2177
17500	C NOW SPACER CAN BE SET AT THIS POINT
17600		SET4=RB
17700		GO TO 2303
17800	2310	FORMAT(A1,5F)
17850	2177	GO TO 80041
18000		IF(STAFF.GE.99)GO TO 690
18100	C  TYPE 99 OR 999 TO ESCAPE WHEN IN READ-IN MODE
18200		REND=0
18250		GO TO 80041
21300	2111	IDEV=JDEV
21400		RETURN
21500	CC168	IF(NOSET.EQ.0)RETURN
21600	
21700	80052	FORMAT(F,A4,A5,2F)
21800	267	IDEV=5
21900		IF(MODE.EQ.3)CALL NOTNUM
22000		GO TO 2111
22200	4	IF(IDEV.EQ.5)CALL TYPSTR('ADD BEAMS?  ')
22300	330	READ(IDEV,2114,END=677)INP
22500		CALL LULOOP
22600		IF(INP1.EQ.LGG)GO TO 677
22800	C  TYPE 'GO' TO PASS LATER ITEMS
22900		IF(INP1.EQ.N9.AND.INP2.EQ.INP1)GO TO 99
23000		IF(INP1.EQ.LBB)GO TO 99
23100		IF(INP1.EQ.LYY)GO TO 1
23200	C  FOR BEAMS? TYPE 'nB' INSTEAD OF 'Y' FOR AUTOMATIC.
23300		IF(INP1.EQ.LNN)GO TO 2000
23400		IF(INP1.EQ.ISEMI)GO TO 2000
23500		IF(INP1.EQ.LESS)GO TO 267
23600		IF(INP1.NE.IGT)GO TO 767
23700		IDEV=1
23800		GO TO(1,2,3,4,5)MODE
23900	767	IF(INP1.NE.IBLA)GO TO 5177
24000	2000	MODE=MODE+1
24100		IF(IDEV.EQ.5)WRITE(21,2114)INP4
24200		GO TO 11
24700	690	REND=1
24800		GO TO 2111
25000	3	IF(IDEV.EQ.5)CALL TYPSTR('ADD MARKS?  ')
25100		GO TO 330
25200	5	IF(IDEV.EQ.5)CALL TYPSTR('ADD SLURS?  ')
25300		GO TO 330
25400	
25500	8006	MODE=MODE+1
26000		IF(MODE.GT.5)GO TO 677
26100		IF(IDEV.NE.5)GO TO 367 
26200	C RETURN ONLY IF IN TTY MODE. (NOT READING A FILE)
26300		GO TO 2111
26400	677	IF(IDEV.NE.5)GO TO 68
26500		END FILE 21
26600		CALL TYPSTR('INPUT SAVED ON FOR21.DAT')
26700		CALL TYPCRLF
26800	68	REND=-1
26900		GO TO 2111
27100	
27200	99	IF(INP3.EQ.N9)GO TO 999
27300	C ELSE GET ANOTHER CHANCE TO SAY 'NO'.  99=BACKUP,  999=ESCAPE
27400		MODE=MODE-1
27500		IF(MODE.EQ.0)GO TO 999
27600		IS=ISV(MODE)
27700		GO TO 11
27800	C  INSERT BACKUP ROUTINE
27900	999	REND=99
28000		GO TO 2111
28100	C FIX BACKUPS********
28200	
28300	8015	RA=0
28400		DO 15 J=1,I-1
28500	15	RA=RA+4./V(J)
28600		K=IRHY-I+1
28700		CALL TYPSTR('TOTAL RHY=')
28800		CALL TYPFLT(RA)
28900		CALL TYPSTR(' QTRS. ')
29000		CALL TYPINT(K)
29100		CALL TYPSTR(' MORE RHYTHMS NEEDED')
29200		CALL TYPCRLF
29300		IDEV=5
29400	C RETURNS TO TTY MODE IF READING A FILE WITH 'FILE' FEATURE.
29700	2	IF(IDEV.EQ.5)CALL TYPSTR('TYPE ')
29800		CALL TYPINT(IRHY)
29900		CALL TYPSTR(' RHYTHMS')
30000		CALL TYPCRLF
30100	
30200	1	ISV(MODE)=IS
30300		CALL TYPE
30400		IF(INP1.NE.IAT)GO TO 1001
30500	C '@' STARTS MODE2 INPUT
30600		IF(INP2.NE.IBLA)GO TO 1001
30700	C BUT NOT IF IT'S REALLY A MOTIVE CALL
30750		IF(IDEV.EQ.5)END FILE 21
30775	C CLOSE THE BACKUP FILE
30800		CALL PRESCN
30900		CALL IFILE(22,'MODE2')
31000		READ(22,2114)INP
31100		CALL LULOOP
31300		IDEV=22
31350	C IDEV  CHANGES BACK BEFORE RETURN TO MAIN.
31400		Z=STUP
31500		CALL SETUP
31600	C MUST RECALL SETUP BECAUSE SOME ARRAYS WERE USED IN PRESCN.(??)
31700		STUP=Z
31800		GO TO 6177
32100	1001	CALL LULOOP
32200		CALL A2READ(RA,RB)
32300		IF(RA.NE.'SP')GO TO 5177
32400		SET4=RB
32500	C CAN SET SPACER HERE
32600		GO TO 1177
32700	5177	IF(INP1.EQ.IBLA) GO TO 1
32800		IF(INP1.NE.N9)GO TO 80041
32900		IF(INP2.EQ.N9)GO TO 99
33000	C  TYPE '99' TO BACK-UP
33200	80041	IF(IDEV.EQ.5)WRITE(21,2114)INP
33300	6177	CALL LNEND
33400		GO TO(333,433,533)MODE-2
33500	C GO TO MARKZ, BEAMS, SLURZ
33600		RETRO=-1.
33700		I=1
33800		PARENS=0
33900		MOT=0
34000	      JZ=1  
34100		IAMP=0
34200	C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
34300	      KL=0  
34400	      RA=0  
34500		IF(MODE.EQ.2)GO TO 2408
34600	C NEXT CHECKS FOR STAFF NUM AT FRONT OF INPUT LINE#1.
34700		IF(INP1.NE.LSS)GO TO 2408
34800		IF(INP2.NE.LTT)GO TO 2408
34900		K=1
35000		L=3
35100		IF(INP3.NE.MINUS)GO TO 1277
35200		K=-1
35300		L=4
35400	1277	STAFF=NALF(INP(L))*K
35500	2277	MLX=L+1
35600		IF(INP(MLX).NE.KSLA)GO TO 2277
35700		MLX=MLX+1
35800		GO TO 3277
35900	2408	MLX=1
36000	3277	L=-1
36200	C   GO SORT OUT THE NEW FORMAT
36300		DO 2999 K=1,72
36400		N=INP(K)
36500		IF(N.EQ.IBLA)GO TO 2999
36600		L=0 
36700		IF(N.EQ.ISTAR)GO TO 277
36800		IF(N.NE.ISEMI)GO TO 2999
36900	C  READS 72 CHARS. INCLUDING ;.
37000	277	INP(K+1)=ISEMI
37100		GO TO 1773
37200	C  --- X/Y/Z* ---  WITH NO SEMICOLON WORKS FOR THIS PROG. ONLY!
37300	2999	CONTINUE
37400		IF(IREAD)GO TO 8015
37500		CALL TYPSTR('****** TRY AGAIN ***** ')
37600		CALL TYPCRLF
37700		GO TO 1
37800	
37900	1299	IF(JZ.NE.0)GO TO 1773
39200	7773	CALL TYPE
39300	
39400		IF(INP1.EQ.IBLA)GO TO 7773
39500		IF(IDEV.EQ.5)WRITE(21,2114)INP
39600		CALL LULOOP
39700	77732	CALL LNEND
39800		JM=-1
39900		JZ=0
40000		GO TO 2408
40100	C   'LISTS' MUST END WITH ; 
40200	1773	JZ=0
40300		DBST=1.
40400		IF(XDBST)DBST=-DBST
40500		XDBST=0
40600	17731	ML=MLX
40700		IF(PARENS.LE.0.)GO TO 975
40800	C  PARENS=-1, OPENS; =1, CLOSES; =0, NONE
40900	3362	PARENS=0
41000		MOT=I-LMOT
41100		IF(LCNT+MOT.LT.198)GO TO 33621
41200		CALL TYPSTR(' NO ROOM FOR MOTIVE ')
41300		CALL TYPCHR(JMOT,1)
41400		CALL TYPCRLF
41500		GO TO 1
41600	33621	JLIST(LCNT+1)=MOT
41700		LCNT=LCNT+2
41800		DO 2140 JG=0,MOT-1
41900	2140	RLIST(LCNT+JG)=V(LMOT+JG)
42000		LCNT=LCNT+MOT
42100		IF(IAMP)GO TO 3013
42200	C  FOR CLOSE PARENS ON LAST ITEM
42300	C   STORE MOTIVE IN RLIST ARRAY
42400	
42500	975	DO 236 JDD=ML,72
42600		JD=JDD
42700		N=INP(JD)
42800	C ((((())))) MAY 13,71 /Z (D4/E/X 2 3/) CS/ ETC.  CAN USE 26 LABELS.
42900		IF(N.EQ.ILP)GO TO 477
43000		IF(N.EQ.IRP)GO TO 477
43100		IF(N.NE.ICOL)GO TO 2361
43200	477	INP(JD)=IBLA
43300		IF(N.NE.ICOL)GO TO 1113
43400		XDBST=-1.
43500		GO TO 5362
43600	C  GO CHANGE IT TO A SEMIC.  !!! CAN'T END LINE WITH :
43700	C SO NXT NOTE WILL BE DBST (TYPE /F:A:C/ ETC.)
43800	C  DBSTS WILL BE ONLY ONE 'REP' UNIT X*0Z%~#&@
43900	1113	L=JD-1
44000	5113	IF(INP(L).NE.IBLA)GO TO 2113
44100		L=L-1
44200		GO TO 5113
44300	2113	IF(N.EQ.IRP)GO TO 3361
44400	C  ONLY ONE () AS YET,  NO NESTING
44500	1140	JMOT=INP(L)
44600	C   MOTIVE NAME
44700		DO 11401 JC=1,LCNT-1
44800		IF(JMOT.NE.JLIST(JC))GO TO 11401
44900	C  FINDS DUPLICATE IDENTIFIER
45000		CALL TYPSTR(' MOTIVIC (')
45100		CALL TYPCHR(JMOT,1)
45200		CALL TYPSTR(') USED TWICE')
45300		CALL TYPCRLF
45400		JLIST(JC)=0
45500	C  ZERO OUT PREVIOUS USE OF IDENTIFIER.
45600	11401	CONTINUE
45700		JLIST(LCNT)=JMOT
45800		PARENS=-1.
45900	C   A PARENTH IS OPEN
46000		INP(L)=IBLA
46100		LMOT=I
46200	C   LMOT IS CURRENT POINT IN V ARRAY
46300		GO TO 236
46400	3361	IF(PARENS.NE.0)GO TO 33612
46500		CALL TYPSTR('PARENTH ERROR - GOING ON')
46600		CALL TYPCRLF
46700	33611	INP(JD)=IBLA
46800		GO TO 236
46900	33612	PARENS=1.
47000	C   SETS PARENS CLOSED FLAG
47100		GO TO 33611
47200	C   NO INVERSIONS POSSIBLE NOW
47300	2361	IF(N.NE.IAT)GO TO 5361
47400		DO 113 L=1,72
47500		K=JD+L
47600	C   K IS USED AT 240!!!
47700		JG=INP(K)
47800		IF(JG.NE.NEG)GO TO 7113
47900		RETRO=0
48000		INP(K)=IBLA
48100		GO TO 113
48200	7113	IF(JG.NE.IBLA)GO TO 4113
48300	113	CONTINUE
48400	4113	DO 6361 L=1,LCNT
48500		IF(JG.NE.JLIST(L))GO TO 6361
48600		VX1=0
48700		DO 40 M=JD+2,72
48800		JG=INP(M)
48900		IF(JG.EQ.IBLA)GO TO 40
49000		IF(JG.EQ.KSLA)GO TO 140
49100		IF(JG.EQ.ISEMI)GO TO 140
49200		IF(JG.EQ.ISTAR)GO TO 140
49300		ML=M
49400		GO TO 240
49500	40	CONTINUE
49600	240	JC=JM
49700		JM=-1
49800		INP(K)=IBLA
49900		JN=0
50000	C   MUST BE ZERO IN SCANR
50100		CALL SCANR
50200		JM=JC
50300	140	JC=1
50400		KN=L+2
50500		M=KN+JLIST(L+1)
50600		IF(RETRO)GO TO 940
50700		KN=M-1
50800		M=L+1
50900		JC=-1
51000		RETRO=-1.
51100	
51200	940	Z=RLIST(KN)
51300		IF(VX1.EQ.0)GO TO 540
51400	C  " @Q N "  WHERE N= DIATONIC STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
51500		IF(MODE.EQ.1)GO TO 440
51600	C  MODE 1 IS NOTES, 2 IS RHY.
51700		V(I)=Z*VX1
51800		GO TO 7361
51900	440	IF(ABS(Z).GE.2000.)GO TO 540
52000	C  SKIPS NON-NOTES
52100		RB=VX1
52200		IF(Z)RB=-RB
52300	C NOW TRANSPOSES BY DIAT. STEPS ONLY 100S=FLAT, 200S=SHARP, 300S=NAT
52400	C  NEG NUMS ARE CHORD NOTES.
52500		V(I)=Z+RB
52600		GO TO 7361
52700	540	V(I)=Z
52800	7361	I=I+1
52900		KN=KN+JC
53000		IF(KN.NE.M)GO TO 940
53100	
53200		RB=V(I-1)
53300		DO 8361 L=JD,72
53400		JG=INP(L)
53500		INP(L)=IBLA
53600		IF(JG.EQ.KSLA)GO TO 9361
53700		IF(JG.EQ.ISEMI)GO TO 93611
53800	8361	IF(JG.EQ.ISTAR)IAMP=-1
53900	9361	MLX=L
54000		IF(IAMP.EQ.0)GO TO 17731
54100		JZ=-1
54200	93611	IF(IAMP)GO TO 3013
54300		GO TO 7773
54400	6361	CONTINUE
54500		CALL TYPSTR(' MOTIVIC (')
54600		CALL TYPCHR(JG,1)
54700		CALL TYPSTR(') NOT FOUND')
54800		CALL TYPCRLF
54900		GO TO 11401
55000	C @@@@@@@@@@@@@@@@@@@@@@@@@@
55100	5361	IF(N.NE.KSLA)GO TO 636
55200	5362	MLX=JD+1
55300		JZ=-1
55400		INP(JD)=ISEMI
55500	436	IF(INP(MLX).NE.IBLA)GO TO 103
55600		MLX=MLX+1
55700		GO TO 436
55800	636	IF(N.EQ.ISEMI)GO TO 103
55900	936	IF(N.NE.IDOT)GO TO 736
56000		L=INP(JD+1)
56100		KL=NALF(L)
56200		IF(L.LE.0)GO TO 577
56300		IF(KL.LT.0)GO TO 577
56400		IF(KL.LE.9)GO TO 236
56500	C   JUMP IF IT'S A NUMBER
56600	577	IF(MODE.EQ.2)INP(JD)=1
56700	C :::::::::******* ↑↑↑↑ MODE #?
56800		GO TO 236
56900	C   CHANGES DOTTED RHYTHMS TO '1'S.
57000	736	IF(N.NE.ISTAR)GO TO 236
57100		IAMP=-1
57200		INP(JD)=ISEMI
57300		GO TO 103
57400	236	CONTINUE
     

00100	2114	FORMAT(72A1)
00200	21141	FORMAT(I,72A1)
00300	
00400	5016	IF(IAMP.GE.0)GO TO 1299
00500		IF(PARENS.NE.0)GO TO 3362
00600	C  PARENS ARE STILL OPEN?
00700		GO TO 3013
00800	103	K=INP(ML)
00900	
01000	C   LAST SECTION
01100		IF(K.EQ.ISEMI)GO TO 1014
01200	C*********** MODE #?
01300		IF(K.NE.IBLA) GO TO 1899
01400		ML=ML+1
01500		GO TO 103
01600	1899	JN=0
01700	C   MUST BE ZERO IN SCANR
01800		VX4=0
01900		NOAC=0
02000		CALL SCANR
02100	      IF(VX1.EQ.-99.)GO TO 4022
02200	C NO MORE COMPOSITES IN RHYTH.  DOTS ARE INDICATED BY 100S.
02300	C RHYTH. NUMB IS KEPT HERE.  DOTTED QUARTER IS NOW 104. DBL..=204
02400	17	IF(MODE.NE.2)GO TO 117
02500		IF(JJ.EQ.1)GO TO 117
02600		IF(VX2.EQ.0)GO TO 117
02700	C VX2=0 IF "X" IS USED.  (8X3  FORMS VX1=8, VX2=0, VX3=3)
02800		RB=0
02900		DO 2117 K=1,JJ
03000	2117	RB=RB+4./VX(K)
03100		VX1=4./RB
03200	C FOR COMPOSITE RHYTHMS. (USEFUL FOR 'WHOLE' RESTS IN 5/4, ETC.)
03300		JJ=1
03400	117	V(I)=VX1
03500		IF(VX4.EQ.0)GO TO 115
03600		IF(MODE.NE.1)GO TO 115
03700		I=I+1
03800	C  FOR + OR -.  AUTO OCTAVES, ETC.
03900		V(I)=-VX1-VX4
04000	115	IF(JJ.LE.1)GO TO 114
04100		IF(MODE.NE.1)GO TO 171
04200		IF(VX2.EQ.0)GO TO 171
04300	C  JUMP IF RHY OR 'X 4' ETC.
04400		V(I)=18000.0+VX1*10.0+VX2/10.0
04500	C  PACKS 2 METER NUMS INTO ONE SLOT (18xyz.n  xy=top, zn=bottom)
04600	114	I=I+1
04700		GO TO 5016
04800	171	JC=1
04900		JD=VX(JJ)-1
05000		I=I+1
05100		GO TO 5005
05200	1014	JD=1
05300		JC=1
05400	C  X4/ CREATES REP 1,4;  A/// CREATES REP 1,3;
05500		GO TO 5005
05600	4022      JC=VX2+.3
05700	      JD=VX3-.5
05800		IF(MODE.EQ.1)NOAC=-1
05900	C ACCIS WILL NOT!! REPEAT UNLESS 100 IS ADDED TO 1ST NUM.******6/78
06000		IF(JJ.EQ.2)JD=1
06100	C   JD=HOW MANY TIMES,  JC=HOW MANY NOTES 
06200		IF(JC.LT.100)GO TO 5005
06300	C ADD 100 TO NUM OF NOTES TO REPEAT ACCIS WITH 'REP N1, N2'.
06400		JC=JC-100
06500		NOAC=0
06600	5005	N=0
06700		DO 3005 K=I-1,1,-1
06800		IF(V(K))GO TO 3005
06900		IF(V(K).LT.3000)N=N+1
07000	C  COUNTS RESTS AND NOTES ONLY (NO CHORD NOTES)
07100	3005	IF(N.EQ.JC)GO TO 4005
07200	4005	IF(JC.GT.1)GO TO 7005
07300		IF(MODE.EQ.1)NOAC=-1
07400	C 5/76 *******   AF/// WILL CREATE AF/A//-- AN:FS/// = AN:FS/A:F// *******
07500	C  ACCIS ARE DROPPED WITH / OR Xn REPEAT.  (BUT NOT WITH 'REP' OR '/X n,n/')
07600	7005	JC=I-K
07700	C  ALL THIS IS TO FIND COMPLETE CHORDS, BARS, ETC. TO REPEAT.
07800	C  REPS WILL ONLY COUNT RHYTHMIC UNITS.!
07900		DO 1005 K=1,JD    
08000	       NL=I+JC-1  
08100	      DO 2005 L=I,NL    
08200		KN=L-JC
08300		RB=V(KN)
08400		IF(NOAC.GE.0)GO TO 2005
08500		IF(ABS(RB).GE.2000)GO TO 2005
08600	C  SKIP OVER IF NOT A NOTE
08700		RB=AMOD(RB,100.0)+1000.0
08800		IF(V(KN))RB=RB-2000.0
08900	C  DROPS ACCIS WHEN SLASH REP. OR 'X' IS USED.
09000	2005	V(L)=RB
09100	1005      I=I+JC  
09200	      GO TO 5016  
09300	
09400	3013	IF(MODE.NE.2)GO TO 771
09500		IF(I-1.NE.IRHY)GO TO 8015
09600	C  WRONG NUMBER OF ITEMS
09700	771	V(I)=-99.
09800		IF(MODE.NE.1)GO TO 132
09900	C  FOR ADDED NOTES ON SPACING STAFF
10000		CALL NOTES
10100	C SAVES TOTAL OF ITEMS FOR LABEL 168
10200	67	CALL NEWR
10300		IX=IS
10400	C SAVE PTR TO RN ARRAY FOR TREM. OVER BEAM LATER. (IN 'BEAMS.F4')
10500		GO TO 8006
10700	132	CALL RHYTH
10800	C  =50 IS RHYTHM FOR TEXT
10900		GO TO 67
11000	134	IF(IDEV.EQ.5)WRITE(21,2114)INP
11100	C  WRITES TYPED IN REPLY TO 'ADD BEAMS?'
11200	C   ACCENTS ARE IN MARKZ SUBROUTINE
11300		GO TO 8006
11400	533	CALL SLURZ
11500		GO TO 8006
11600	433	CALL BEAMS
11700	C  ADJUSTS STEMS (IBEAM=0) IF BEAMS WERE ENTERED.
11800		IBEAM=0
11900		GO TO 8006
12000	333	CALL MARKZ
12100	135	K=IS
12200		CALL NEWR
12300		IS=K
12400	C  ↑↑↑↑↑↑ TO ADD NEW ITEMS, SUCH AS PPP, MP, CRESC., ETC.(SEE 'MARKS')
12500		GO TO 8006
12600		END
12700	
12800		SUBROUTINE A2READ(A,B)
12900		REREAD 1,A,B
13000		CALL LO2UP(A)
13100	1	FORMAT(A2,F)
13200		END